home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Joystick Magazine 1995 July & August
/
cd No4 joystick No62.iso
/
mac
/
pc
/
EMULATOR
/
PC370
/
DEMO
/
DEMOSSP.ALC
< prev
next >
Wrap
Text File
|
1987-08-09
|
10KB
|
439 lines
TITLE 'TESTSSP - TEST SCIENTIFIC SUBROUTINE PACKAGE'
*
* PGM-ID. TESTSSP.ALC
* AUTHOR. DON HIGGINS
* DATE. 07/24/87
* REMARKS. SEE SSP.ALC AND FP87.DOC FOR MORE INFORMATION.
* MAINTENANCE.
*
* 07/24/87 COPY FROM TESTFP AND MODIFY
* 07/31/87 ADD RANGE TEST OF EXP TO DETECT FRACTION SIGN BUG
* 08/08/87 ADD MOD, SIN, COS, TAN USING LIBRARY FUNCTIONS 14-17
* 08/09/87 ALLOW FOR R15 RETURNING 80X87 EXCEPTION BITS INCLUDING PRECISION
* ADD SIN/COS/TAN RANGE TEST -2*PI,2*PI,PI/6
TESTSSP CSECT
LA R10,0(R15)
LA R11,2048(R10)
LA R11,2048(R11)
USING TESTSSP,R10
USING TESTSSP+4096,R11
LA DE,=C'TESTSSP START$'
SVC WTO
* ALOG
LA DE,=C'TESTSSP STARTING ALOG VALUE TESTS$'
SVC WTO
LA R1,FPLE2
SVC FPSVC FR0=LOGE(2) 80X87 CONSTANT
LER FR2,FR0 FR2=FR0
LE FR0,=E'2'
L R15,=V(ALOG)
BALR R14,R15 FR0=LOGE(2) CALC'ED
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPLE2
SVC FPSVC FR0=LOGE(2) 80X87 CONSTANT
LNER FR2,FR0
LE FR0,=E'.5'
L R15,=V(ALOG)
BALR R14,R15 FR0=LOGE(2) CALC'ED
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* ALOG10
LA DE,=C'TESTSSP STARTING ALOG10 VALUE TESTS$'
SVC WTO
LA R1,FPLT2
SVC FPSVC FR0=LOG10(2) 80X87 CONSTANT
LER FR2,FR0 FR2=FR0
LE FR0,=E'2'
L R15,=V(ALOG10)
BALR R14,R15 FR0=LOG10(2) CALC'ED
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPLT2
SVC FPSVC FR0=LOG10(2) 80X87 CONSTANT
LNER FR2,FR0
LE FR0,=E'.5'
L R15,=V(ALOG10)
BALR R14,R15 FR0=LOG10(2) CALC'ED
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* ATAN
LA DE,=C'TESTSSP STARTING ATAN VALUE TESTS$'
SVC WTO
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'4' FR0=PI/4
LER FR2,FR0
LE FR0,=E'1'
L R15,=V(ATAN)
BALR R14,R15 FR0=ATAN(1.0)=PI/4
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* COS
LA DE,=C'TESTSSP STARTING COS VALUE TESTS$'
SVC WTO
SER FR0,FR0
L R15,=V(COS)
BALR R14,R15 FR0=COS(0.0)=1.0
SE FR0,=E'1'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'4' FR0=PI/4
L R15,=V(COS)
BALR R14,R15 FR0=COS(PI/4)=SQRT(2)/2.
LER FR2,FR0
LE FR0,=E'2'
L R15,=V(SQRT)
BALR R14,R15
DE FR0,=E'2'
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'2' FR0=PI/2
L R15,=V(COS)
BALR R14,R15 FR0=COS(PI/2)=0.0
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* EXP
LA DE,=C'TESTSSP STARTING EXP VALUE TESTS$'
SVC WTO
LA R1,FPLE2
SVC FPSVC FR0=LOGE(2) 80X87 CONSTANT
L R15,=V(EXP)
BALR R14,R15 FR0=E**LOGE(2)=2 CALC'ED
SE FR0,=E'2'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LE FR0,=E'0'
L R15,=V(EXP)
BALR R14,R15 FR0=E**(0) CALC'ED
SE FR0,=E'1'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPLE2
SVC FPSVC FR0=LOGE(2) 80X87 CONSTANT
LNER FR0,FR0 FR0=-LOGE(2)
L R15,=V(EXP)
BALR R14,R15 FR0=E**(-LOGE(2)) CALC'ED
SE FR0,=E'0.5'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LE FR0,=E'10'
L R15,=V(ALOG)
BALR R14,R15 FR0=LOGE(10) CALC'ED
L R15,=V(EXP)
BALR R14,R15 FR0=E**(LOGE(10)) CALC'ED
SE FR0,=E'10'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LE FR0,=E'0.1'
L R15,=V(ALOG)
BALR R14,R15 FR0=LOGE(0.1) CALC'ED
L R15,=V(EXP)
BALR R14,R15 FR0=E**(LOGE(0.1)) CALC'ED
SE FR0,=E'0.1'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* INT
LA DE,=C'TESTSSP STARTING INT VALUE TESTS$'
SVC WTO
LE FR0,=E'123.456'
L R15,=V(INT)
BALR R14,R15
CL R0,=F'123'
BAL R14,CCE
LE FR0,=E'-123.456'
L R15,=V(INT)
BALR R14,R15
CL R0,=F'-123'
BAL R14,CCE
* MOD
LA DE,=C'TESTSSP STARTING MOD VALUE TESTS$'
SVC WTO
LD FR0,=D'123.456'
LD FR2,=D'1'
L R15,=V(MOD)
BALR R14,R15
SD FR0,=D'0.456'
LPER FR0,FR0
CD FR0,DERR
BAL R14,CCL
LD FR0,=D'10'
LD FR2,=D'3'
L R15,=V(MOD)
BALR R14,R15
SD FR0,=D'1'
LPER FR0,FR0
CD FR0,DERR
BAL R14,CCL
* REAL
LA DE,=C'TESTSSP STARTING REAL VALUE TESTS$'
SVC WTO
L R0,=F'123'
L R15,=V(REAL)
BALR R14,R15
CE FR0,=E'123'
BAL R14,CCE
L R0,=F'-123'
L R15,=V(REAL)
BALR R14,R15
CE FR0,=E'-123'
BAL R14,CCE
* SIN
LA DE,=C'TESTSSP STARTING SIN VALUE TESTS$'
SVC WTO
SER FR0,FR0
L R15,=V(SIN)
BALR R14,R15 FR0=SIN(0.0)=1.0
SE FR0,=E'0'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'4' FR0=PI/4
L R15,=V(SIN)
BALR R14,R15 FR0=SIN(PI/4)=SQRT(2)/2.
LER FR2,FR0
LE FR0,=E'2'
L R15,=V(SQRT)
BALR R14,R15
DE FR0,=E'2'
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'2' FR0=PI/2
L R15,=V(SIN)
BALR R14,R15 FR0=SIN(PI/2)=1.0
SE FR0,=E'1'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* SQRT
LA DE,=C'TESTSSP STARTING SQRT VALUE TESTS$'
SVC WTO
LE FR0,=E'4'
L R15,=V(SQRT)
BALR R14,R15
CE FR0,=E'2'
BAL R14,CCE
LD FR0,=D'2.25'
L R15,=V(SQRT)
BALR R14,R15
CD FR0,=D'1.5'
BAL R14,CCE
LD FR0,=D'12345'
MDR FR0,FR0
L R15,=V(SQRT)
BALR R14,R15
SD FR0,=D'12345'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
* TAN
LA DE,=C'TESTSSP STARTING TAN VALUE TESTS$'
SVC WTO
SER FR0,FR0
L R15,=V(TAN)
BALR R14,R15 FR0=TAN(0.0)=0.0
SE FR0,=E'0'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'4' FR0=PI/4
L R15,=V(TAN)
BALR R14,R15 FR0=TAN(PI/4)=1.0
SE FR0,=E'1'
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R1,FPPI
SVC FPSVC FR0=PI
DD FR0,=D'2' FR0=PI/2
L R15,=V(TAN)
BALR R14,R15 FR0=TAN(PI/2)=1.0*16**63 PLUS DIVIDE CHK ERR
LTR R15,R15
BAL R14,CCH VERIFY RC>0 DUE TO EXCEPTION
STE FR0,WE0
NI WE0,X'7F'
CLC WE0,=X'7F800000' ABS COMPARE WITH FP87 MAX CONSTANT
BAL R14,CCE
LA DE,=C'TESTSSP STARTING RANGE TESTS$'
SVC WTO
* SIN/COS/TAN RANGE TEST -2*PI,2*PI,PI/6
LA DE,=C'TESTSSP STARTING SIN/COS RANGE TESTS$'
SVC WTO
LA R1,FPPI
SVC FPSVC FR0=PI
LDR FR6,FR0
DD FR6,=D'6' FR6=PI/6 INCR ARG.
LDR FR4,FR0
ADR FR4,FR4 FR4=2*PI MAX. ARG.
LNDR FR2,FR4 FR2=-2*PI CURRENT ARG.
LA R2,1
SLOOP EQU *
LER FR0,FR2
L R15,=V(SIN)
BALR R14,R15 FR0=SIN(X)
STD FR0,SAVSIN
LDR FR0,FR2
SDR FR0,FR6
SDR FR0,FR6
SDR FR0,FR6
L R15,=V(COS)
BALR R14,R15 FR0=COS(X-PI/2)
SD FR0,SAVSIN
LPDR FR0,FR0
CD FR0,DERR VERFIFY SIN(X)=COS(X-PI/2) WITHIN DERR
BAL R14,CCL
SP PTAN,=P'1' DEC SKIP COUNTER
BNZ TSTTAN
ZAP PTAN,=P'6' RESET COUNTER TO SKIP AGAIN AT +PI
B SKPTAN
TSTTAN EQU *
LER FR0,FR2
L R15,=V(COS)
BALR R14,R15 FR0=COS(X)
STD FR0,SAVCOS
LD FR0,SAVSIN
DD FR0,SAVCOS
STD FR0,SAVTAN SIN(X)/COS(X)
LER FR0,FR2
L R15,=V(TAN)
BALR R14,R15 FR0=TAN(X)
SD FR0,SAVTAN
LPDR FR0,FR0
CD FR0,DERR VERFIFY TAN(X)=SIN(X)/COS(X) WITHIN DERR
BAL R14,CCL
SKPTAN EQU * SKIP TAN TEST FOR COS(X)=0
LA R2,1(R2)
ADR FR2,FR6
CDR FR2,FR4
BL SLOOP
* EXP AND ALOG RANGE TEST 0.1 TO 10 BY 0.1
LA DE,=C'TESTSSP STARTING EXP/ALOG 0.1,10,0.1 RANGE TESTS$'
SVC WTO
LE FR2,=E'0.1' X
LA R2,1
XLOOP EQU *
LER FR0,FR2
L R15,=V(ALOG)
BALR R14,R15 FR0=LOGE(X) CALC'ED
L R15,=V(EXP)
BALR R14,R15 FR0=E**(LOGE(X)) CALC'ED
SER FR0,FR2
LPER FR0,FR0
CD FR0,DERR VERFIFY RESULT WITHIN DERR
BAL R14,CCL
LA R2,1(R2)
AE FR2,=E'0.1'
CE FR2,=E'10'
BL XLOOP
TESTEOJ EQU *
LA DE,CMSG
SVC WTO
LA DE,=C'TESTSSP END$'
SVC WTO
SVC TRACE
DC C'ERX '
SVC EXIT
CCE BE CCOK
CCBAD SVC TRACE
DC C'BUG'
CCOK LA R12,1(R12)
ST R14,SAVELINK
L R13,SAVELINK
LA R4,DCOUNT+2
LA R3,0
CLOOP IC R3,0(R4)
O R3,=X'000000F0' CHANGE BLANK TO DIGIT
A R3,=F'1'
C R3,=X'000000FA'
BL CDONE
L R3,=X'000000F0'
STC R3,0(R4)
S R4,=F'1'
B CLOOP
CDONE STC R3,0(R4)
B 0(R14)
CCL BL CCOK
B CCBAD
CCH BH CCOK
B CCBAD
CCNE BNE CCOK
B CCBAD
CC3 BO CCOK
B CCBAD
SAVELINK DC A(0)
*
* DATA
*
FR0 EQU 0
FR2 EQU 2
FR4 EQU 4
FR6 EQU 6
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R10 EQU 10 BASE 1
R11 EQU 11 BASE 2
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
WE0 DC E'0'
WD0 DC D'0'
NAN DC X'E060000000000000'
CMSG DC C'TOTAL TESTS = '
DCOUNT DC C' '
DC C'$'
DC 0F'0',C'* FWORD*'
FWORD DC F'0'
HWORD DC H'0'
SPIE EQU 14 SET SPIE
TRACE EQU 9 TRACE SVC - MUST BE FOLLOWED BY 3 CHAR. ID
WTO EQU 209 CPM WRITE TO OPERATOR (CPM SVC 9)
EXIT EQU 0 EXIT EMULTOR SVC
DE EQU 2 REG. 2 MAPS TO DE FOR CP/M SVC'S
FPSVC EQU 35
FPLT2 EQU 1
FPLE2 EQU 2
FPL2E EQU 3
FPL2T EQU 4
FPPI EQU 5
DERR DC D'1E-12' ERROR THRESHOLD
SAVSIN DC D'0'
SAVCOS DC D'0'
SAVTAN DC D'0'
PTAN DC P'4' SET TO SKIP TAN TEST AT PI/2
END TESTSSP